home *** CD-ROM | disk | FTP | other *** search
/ Mac Magazin/MacEasy 32 / Mac Magazin and MacEasy Magazine CD - Issue 32.iso / Multimedia / MIDI / MidiChaos_15 Folder / MidiChaos_1.5 / Source / Screen < prev    next >
Text File  |  1992-04-24  |  10KB  |  388 lines
  1. \ Control screen for MIDIChaos
  2.  
  3. \ Author: Darren Gibbs  Copyright 1990
  4. \ Date: 4/26/90
  5. \
  6. \ MOD: RDG  6/20/90    Restructured for polyphony.
  7. \ MOD: RDG  9/20/90    Major restructuring; added support for new equations.
  8. \ MOD: RDG  10/5/90    Restructured once again to support voice objects.
  9.  
  10. ANEW TASK-MC_SCREEN
  11.  
  12. VARIABLE CURRENT-VOICE
  13. VARIABLE CURRENT-PARAM
  14.  
  15. : GET.GENERATOR  ( -- addr , get current generator for current voice )
  16.     current-param @  current-voice @  generator@: []
  17. ;
  18.  
  19. \ Build faders.
  20.    OB.FADER  P1-FADER
  21.    OB.FADER  P2-FADER
  22.    OB.FADER  X-FADER
  23.    OB.FADER  LOW-FADER
  24.    OB.FADER  HI-FADER
  25.  
  26. \ Fader functions to update parameters for each record.
  27. : P1.FUNC  ( value part -- , set p1 parameter for current voice )
  28.     drop 
  29.     get.generator  put.p1: []
  30. ;
  31.  
  32. : P2.FUNC  ( value part -- , set p2 parameter for current voice )
  33.     drop 
  34.     get.generator  put.p2: []
  35. ;
  36.  
  37. : X.FUNC  ( value part -- , set x parameter for current voice )
  38.     drop 
  39.     get.generator  put.x: []
  40. ;
  41.  
  42. : LOW.FUNC  ( value part -- , set lowest allowable output value )
  43.     drop
  44.     dup
  45.     get.generator  put.min: []
  46.     1+ 0 put.min: hi-fader
  47. ;
  48.  
  49. : HI.FUNC  ( value part -- , set highest allowable output value )
  50.     drop
  51.     dup
  52.     get.generator  put.max: []
  53.     1- 0 put.max: low-fader
  54. ;
  55.  
  56. : SET.FADER.FUNCTIONS  ( -- , put function addresses into faders )
  57.     'c p1.func dup 
  58.       put.down.function: p1-fader   put.move.function: p1-fader
  59.     'c p2.func dup 
  60.       put.down.function: p2-fader   put.move.function: p2-fader
  61.     'c x.func dup 
  62.       put.down.function: x-fader   put.move.function: x-fader
  63.     'c low.func dup 
  64.       put.down.function: low-fader put.move.function: low-fader
  65.     'c hi.func dup 
  66.       put.down.function: hi-fader  put.move.function: hi-fader
  67. ;
  68.     
  69. : BUILD.FADER  ( w h incr knob_size fader -- )
  70.     dup>r put.knob.size: []
  71.     r@ put.increment: []
  72.     r@ put.wh: []
  73.     true r> if.show.value: []
  74. ;
  75.  
  76. : P1-FADER-DATA  ( -- w h incr knob_size )
  77.     180 3000 1 100 p1-fader ;
  78. : P2-FADER-DATA  ( -- w h incr knob_size )
  79.     180 3000 1 100 p2-fader ;
  80. : X-FADER-DATA  ( -- w h incr knob_size )
  81.     180 2000 1 100 x-fader ;
  82. : LOW-FADER-DATA  ( -- w h incr knob_size )
  83.     180 1000 1 100 low-fader ;
  84. : HI-FADER-DATA  ( -- w h incr knob_size )
  85.     180 1000 1 100 hi-fader ;
  86.  
  87. : BUILD.FADERS  ( -- )
  88.     p1-fader-data   build.fader
  89.       "  P1 " put.title: p1-fader
  90.     p2-fader-data   build.fader
  91.       "  P2 " put.title: p2-fader
  92.     x-fader-data   build.fader
  93.       "  X " put.title: x-fader
  94.         1 0 put.min: x-fader   99 0 put.max: x-fader
  95.     low-fader-data build.fader
  96.         0 0 put.min: low-fader  127 0 put.max: low-fader
  97.     hi-fader-data  build.fader
  98.         1 0 put.min: hi-fader   127 0 put.max: hi-fader
  99.  
  100.     set.fader.functions
  101. ;
  102.  
  103. \ -------------------------------------------------------------------------------
  104. \ Words for the managing of a voice's faders.
  105. \ -------------------------------------------------------------------------------
  106. : SET.FADER.LIMITS  ( -- )
  107.     get.function.min/max
  108.     ?dup IF
  109.         -1 0 put.enable: p2-fader
  110.         0 put.max: p2-fader  0 put.min: p2-fader
  111.     ELSE
  112.         0 0 put.enable: p2-fader
  113.     THEN        
  114.     0 put.max: p1-fader  0 put.min: p1-fader
  115. ;
  116.  
  117. : UPDATE.PARAMETER.FADERS  ( -- )
  118.     get.generator dup get.function: [] 
  119.     set.fader.limits
  120.     dup \ generator    
  121.     get.p1: []  0  put.value: p1-fader
  122.     get.p2: []  0  put.value: p2-fader
  123. ;
  124.  
  125. \  Words for updating scaling faders.
  126. $ROM SCALING-TITLES  
  127.     ," Lowest Note    "  ," Highest Note   " 
  128.     ," Min Velocity   "  ," Max Velocity   " 
  129.     ," Min Duration   "  ," Max Duration   "   
  130.  
  131. : NOTE-SCALING-TITLES  ( -- str1 str2 )
  132.     0 scaling-titles   1 scaling-titles ;
  133. : VEL-SCALING-TITLES  ( -- str1 str2 )
  134.     2 scaling-titles   3 scaling-titles ;
  135. : DUR-SCALING-TITLES  ( -- str1 str2 )
  136.     4 scaling-titles   5 scaling-titles ;
  137.  
  138. : UPDATE.SCALING.FADER.TITLES  ( -- )
  139.     current-param @
  140.     CASE
  141.         note       OF note-scaling-titles ENDOF    
  142.         velocity  OF vel-scaling-titles  ENDOF    
  143.         duration  OF dur-scaling-titles  ENDOF    
  144.     ENDCASE
  145.     put.title: hi-fader   
  146.     put.title: low-fader   
  147. ;
  148.  
  149. : UPDATE.SCALING.FADER.VALUES  { | low hi -- }
  150.     get.generator dup 
  151.     get.min: []  -> low   
  152.     get.max: []  -> hi
  153.     low 1+ 0 put.min: hi-fader
  154.     hi  1- 0 put.max: low-fader
  155.     low 0  put.value: low-fader
  156.     hi  0  put.value: hi-fader
  157. ;    
  158.  
  159. : UPDATE.SCALING.FADERS  ( -- )
  160.     update.scaling.fader.titles
  161.     update.scaling.fader.values
  162. ;
  163.  
  164. : UPDATE.FADERS  ( -- )
  165.     update.parameter.faders
  166.     update.scaling.faders
  167. ;
  168.  
  169. \ -------------------------------------------------------------------------------
  170. \ Setup a grid for changing the equation assigned to a midi parameter.
  171. \ -------------------------------------------------------------------------------
  172. : FUNC.GRID.FUNC  ( value part -- , select a function for Midi parameter )
  173.     nip  
  174.     get.generator  use.function: []  \ uses part# as index to function
  175.     update.faders
  176. ;
  177.  
  178. OB.RADIO.GRID FUNC-GRID
  179.  
  180. : BUILD.FUNC-GRID  ( -- )
  181.     600 300 put.wh: func-grid
  182.     " Function: " put.title: func-grid
  183.     1 get.#functions   new: func-grid
  184.     'c function-names put.text.function: func-grid 
  185.     'c func.grid.func put.down.function: func-grid
  186. ;
  187.  
  188. : UPDATE.FUNC-GRID  ( -- , reset control to reflect desired equation )
  189.     get.generator get.function: []  1 swap put.value: func-grid
  190. ;
  191.  
  192. : INIT.FUNC-GRID  ( -- )
  193.     note current-param !
  194. ;
  195.  
  196. \ -------------------------------------------------------------------------------
  197. \ Setup a grid to change the params currently assigned to the controls.
  198. \ -------------------------------------------------------------------------------
  199. : PARAM.GRID.FUNC  ( value part -- , change control functions )
  200.     nip        \ don't need value    
  201.     current-param !   \ use part# as index to current parameter
  202.     update.func-grid
  203.     update.faders
  204. ;
  205.  
  206. OB.RADIO.GRID PARAM-GRID
  207.  
  208. : BUILD.PARAM-GRID  ( -- )
  209.     600 300 put.wh: param-grid
  210.     " MIDI: " put.title: param-grid
  211.     1 get.#params new: param-grid
  212.     'c parameter-names put.text.function: param-grid 
  213.     'c param.grid.func put.down.function: param-grid
  214. ;
  215.  
  216. \ -------------------------------------------------------------------------------
  217. \ Set up a grid to turn voices on and off
  218. \ -------------------------------------------------------------------------------
  219. OB.RADIO.GRID ON/OFF-GRID
  220. TEXTROM ON/OFF-TEXT  ," OFF" ," ON "  
  221.  
  222. : ON/OFF.GRID.FUNC  ( value part -- , select on/off status of a Voice )
  223.     nip 
  224.     CASE
  225.         0 OF current-voice @ stop:   []  ENDOF
  226.         1 OF current-voice @ start:  [] ENDOF
  227.     ENDCASE
  228. ;
  229.  
  230. : BUILD.ON/OFF-GRID  ( -- )
  231.     300 300 put.wh: on/off-grid
  232.     1 2 new: on/off-grid
  233.     'c on/off-text put.text.function: on/off-grid
  234.     'c on/off.grid.func put.down.function: on/off-grid
  235. ;
  236.  
  237. : UPDATE.ON/OFF-GRID  ( -- )
  238.     current-voice @  ?executing: [] 
  239.     IF 1 1 
  240.     ELSE 1 0 
  241.     THEN put.value: on/off-grid
  242. ;
  243.     
  244. \ -------------------------------------------------------------------------------
  245. \ Grid to set midi channel for each voice
  246. \ -------------------------------------------------------------------------------
  247. : CHAN-GRID.FUNC  ( value part -- )
  248.     drop  \ don't need part 
  249.     current-voice @  put.channel: []
  250. ;
  251.  
  252. OB.NUMERIC.GRID  CHAN-GRID
  253.  
  254. : BUILD.CHAN-GRID  ( -- )
  255.     300 300 put.wh: chan-grid
  256.     1 1 new: chan-grid
  257.  
  258.     1 0 put.min: chan-grid
  259.     16 0 put.max: chan-grid
  260.     1 put.increment: chan-grid
  261.  
  262.     " Chan. #"  put.title: chan-grid
  263.     'c chan-grid.func put.up.function: chan-grid
  264. ;
  265.  
  266. : UPDATE.CHAN-GRID  ( -- )
  267.     current-voice @  get.channel: []
  268.     0 put.value: chan-grid
  269. ;
  270.  
  271. \ -------------------------------------------------------------------------------
  272. \ Words to switch voices.
  273. \ -------------------------------------------------------------------------------
  274. : UPDATE.CONTROLS  ( -- )
  275.     update.on/off-grid
  276.     update.chan-grid
  277.     update.func-grid   
  278.     update.faders
  279. ;
  280.  
  281. : VOICE-GRID.FUNC  ( value part -- )
  282.     nip  \ don't need value 
  283.     at: voice-list  current-voice ! 
  284.     update.controls
  285. ;
  286.  
  287. OB.RADIO.GRID VOICE-GRID
  288.  
  289. : BUILD.VOICE-GRID  ( -- )
  290.     600 300 put.wh: voice-grid
  291.     " Voice:" put.title: voice-grid
  292.     1 many: voice-list  new: voice-grid
  293.     'c voice-names put.text.function: voice-grid
  294.     'c voice-grid.func put.down.function: voice-grid
  295. ;
  296.  
  297. : INIT.VOICE-GRID  ( -- )
  298.     0 at: voice-list current-voice !
  299.     1 0 put.value: voice-grid
  300. ;
  301.  
  302. : INIT.CONTROLS  ( -- )
  303.     init.voice-grid
  304.     init.func-grid   
  305. ;
  306.  
  307. \ -------------------------------------------------------------------------------
  308. \ Set up a grid to start and stop recording.
  309. \ -------------------------------------------------------------------------------
  310. OB.RADIO.GRID RECORD-GRID
  311. TEXTROM  RECORD-TEXT  ," Stop "  ," Start "
  312.  
  313. : START.RECORDING  ( -- )
  314.     " " 100 100 " "  sfputfile
  315.     IF $midifile{
  316.     ELSE 1 0 put.value: record-grid   \ turn control off if canceled
  317.     THEN
  318. ;
  319.  
  320. : STOP.RECORDING  ( -- )
  321.     }midifile
  322. ;
  323.     
  324. : RECORD.GRID.FUNC  ( value part -- , start and stop recording )
  325.     nip
  326.     pause.voices
  327.     CASE
  328.         0 OF stop.recording   ENDOF
  329.         1 OF start.recording  ENDOF
  330.     ENDCASE
  331.     unpause.voices
  332. ;
  333.  
  334. : BUILD.RECORD-GRID  ( -- )
  335.     400 300 put.wh: record-grid
  336.     1 2 new: record-grid
  337.     1 0 put.value: record-grid
  338.     'c record-text put.text.function: record-grid
  339.     " Midi Record" put.title: record-grid
  340.     'c record.grid.func put.down.function: record-grid
  341. ;
  342.  
  343. \ -------------------------------------------------------------------------------
  344. \ Declare and initalize the control screen
  345. \ -------------------------------------------------------------------------------
  346. OB.SCREEN MC-SCREEN
  347.  
  348. : BUILD.SCREEN  ( -- )
  349.     " MidiChaos"  put.title: mc-screen
  350.     0 scg.selnt
  351.  
  352.     build.faders   \ 5 faders
  353.          
  354.     build.param-grid
  355.     build.func-grid
  356.     build.chan-grid
  357.     build.on/off-grid
  358.     build.voice-grid
  359.     build.record-grid
  360.         
  361.     11  3 new: MC-SCREEN
  362.     P1-FADER              2500     500  add: MC-SCREEN
  363.     P2-FADER              2800     500  add: MC-SCREEN
  364.     X-FADER               2150     900  add: MC-SCREEN
  365.     HI-FADER              3200     700  add: MC-SCREEN
  366.     LOW-FADER             3200    2200  add: MC-SCREEN
  367.     PARAM-GRID             150    2250  add: MC-SCREEN
  368.     FUNC-GRID             1100    2250  add: MC-SCREEN
  369.     CHAN-GRID              800    1629  add: MC-SCREEN
  370.     ON/OFF-GRID            800     764  add: MC-SCREEN
  371.     VOICE-GRID             150     750  add: MC-SCREEN
  372.     RECORD-GRID              1320      1030  add: MC-SCREEN
  373.  ;
  374.  
  375. : INIT.MAIN.SCREEN  ( -- )
  376.     build.screen
  377.     init.controls
  378.     'c update.controls put.draw.function: mc-screen
  379. ;
  380.  
  381. : TERM.MAIN.SCREEN  ( -- )
  382.     freeall: mc-screen
  383.     free: mc-screen
  384. ;
  385.  
  386.         
  387.         
  388.